perm filename EDFILL.F4[MSS,LCS] blob
sn#052370 filedate 1974-01-08 generic text, type T, neo UTF8
00100 SUBROUTINE EDFILL
00200 COMMON/ED/K,NEXT,NN,NX,NY,J
00300 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00500 COMMON/ZN/SCLEF(200,2),DDD
00600 COMMON/LL/LL
00610 COMMON/JJJ/JJJ
00700 DIMENSION IP(50)
00800 EQUIVALENCE(M,SCLEF(1,2)),(IP,IST(3050)),(JT,MFILL(1))
00900 C USE M FOR FLAG IN DREDIT
01100 NIST=IST(2)
01200 15 J=2
01210 LA=1
01300 IST(2)=NIST
01400 CALL HYDPOG(1)
01500 CALL ACCPOG(1)
01600 5 K=MFILL(J)
01800 JJ=J+1
01900 IP(LA)=J
01910 LA=LA+1
01955 IP(LA)=0
02000 DO 2 L=JJ,K
02100 CALL UNPACK(L,NX,NY,MFILL)
02200 NX=GTPT(FLOAT(NX),RJB)
02300 NY=GTPT(FLOAT(NY),CENTR)
02400 IF(L.EQ.JJ)GO TO 3
02500 CALL AVECT(NX,NY)
02600 GO TO 2
02700 3 CALL AIVECT(NX,NY)
02800 2 CONTINUE
02900 CALL DPYOUT(1)
03000 IF(K.EQ.JT)GO TO 4
03100 J=K+1
03200 GO TO 5
03300 C ABOVE RETRACES FILL OUTLINES
03400 4 IF(NN.LT.3)NN=3
03410 IP(LA)=JT+1
03500 CALL UNPACK(NN,NX,NY,MFILL)
03510 CALL ITYP
03600 NX=GTPT(FLOAT(NX),RJB)
03700 NY=GTPT(FLOAT(NY),CENTR)
03800 CALL SETCUR(NX,NY,0)
03900 CALL EDTYP(K,X,JJJ)
04100 IF(K.EQ.'X'.OR.K.EQ.'F')RETURN
04150 C F IS TO ADD ON TO FILLER
04200 IF(K.EQ.'D')GO TO 8
04500 570 IF(K.EQ.'A'.OR.K.EQ.'I')GO TO 9
04700 C TYPE "S n" TO STEP AHEAD (OR BACK) n STEPS
04800 C NEXT IS FOR NEXT STEP
04900 11 IF(X.EQ.0)X=1
05000 NN=NN+X
05100 IF(NN.GT.JT)RETURN
05200 IF(NN.LT.3)GO TO 4
05300 DO 12 K=1,LA
05400 IF(NN.NE.IP(K))GO TO 12
05500 NN=NN+1
05600 C AVOIDS WDCNT LOCS.
05700 GO TO 4
05800 12 CONTINUE
05900 GO TO 4
06000 C NEXT FOR DELETE
06050 8 JJ=1
06100 DO 16 J=LA,1,-1
06200 IF(NN.LT.IP(J))GO TO 16
06210 IF(NN.NE.IP(J)-1)GO TO 24
06220 DO 25 N=J,LA
06230 25 IP(N)=IP(N+1)
06240 C DELETES A WDCNT POINTER
06250 JJ=2
06260 LA=LA-1
06300 24 DO 17 N=J,LA
06400 17 MFILL(IP(N))=MFILL(IP(N))-JJ
06500 C REDUCES WDCNTS
06600 13 JT=JT-JJ
06700 DO 18 K=NN,JT
06800 18 MFILL(K)=MFILL(K+JJ)
06850 IF(JT.LT.5)JT=0
06875 C <5 = NO FILLER
06900 GO TO 15
07000 16 CONTINUE
07100 C NEXT IS FOR ALTER
07200 9 M=-1
07300 NEXT=NN+1
07400 CALL DREDIT
07500 M=0
07600 IF(K.EQ.'A')GO TO 19
07650 NN=NEXT
07700 JT=JT+1
07800 DO 20 J=1,LA
07900 IF(NN.GT.IP(J))GO TO 20
08000 DO 21 L=J-1,LA
08100 21 MFILL(IP(L))=MFILL(IP(L))+1
08200 DO 23 L=JT,NN,-1
08300 23 MFILL(L)=MFILL(L-1)
08400 GO TO 19
08500 20 CONTINUE
08600 19 CALL REPACK(NN,NX,NY,MFILL)
08700 NN=NEXT
08800 GO TO 15
09000 C PUT INSERTS HERE
09300 END
09400
09500 SUBROUTINE EDTYP(K,X,JJJ)
10000 TYPE 57
10100 ACCEPT 1,K,X
10200 IF(K.NE.' ')JJJ=0
14000 IF(K.EQ.':'.OR.JJJ)GO TO 2
14100 C TYPE "A" OR ":" TO ALTER
15000 IF(K.NE.'G')RETURN
15100 JJJ=-1
15200 2 K='A'
15300 RETURN
16000 57 FORMAT(' TYPE D, A, I OR X ',$)
16100 1 FORMAT(A1,2F)
16200 END
16210
16220 SUBROUTINE ITYP
16225 COMMON/ED/K,NEXT,NN,NX,NY,J
16230 TYPE 1,NN,NX,NY
16240 RETURN
16250 1 FORMAT(I4,')',2I6)
16260 END